home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / ExtUtils / CBuilder / Platform / VMS.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  10.3 KB  |  295 lines
  1. package ExtUtils::CBuilder::Platform::VMS;
  2.  
  3. use strict;
  4. use ExtUtils::CBuilder::Base;
  5.  
  6. use vars qw($VERSION @ISA);
  7. $VERSION = '0.22';
  8. @ISA = qw(ExtUtils::CBuilder::Base);
  9.  
  10. use File::Spec::Functions qw(catfile catdir);
  11.  
  12. # We do prelink, but don't want the parent to redo it.
  13.  
  14. sub need_prelink { 0 }
  15.  
  16. sub arg_defines {
  17.   my ($self, %args) = @_;
  18.  
  19.   s/"/""/g foreach values %args;
  20.  
  21.   my @config_defines;
  22.  
  23.   # VMS can only have one define qualifier; add the one from config, if any.
  24.   if ($self->{config}{ccflags} =~ s{/  def[^=]+  =+  \(?  ([^\/\)]*)  } {}ix) {
  25.     push @config_defines, $1;
  26.   }
  27.  
  28.   return '' unless keys(%args) || @config_defines;
  29.  
  30.   return ('/define=(' 
  31.           . join(',', 
  32.          @config_defines,
  33.                  map "\"$_" . ( length($args{$_}) ? "=$args{$_}" : '') . "\"", 
  34.                      keys %args) 
  35.           . ')');
  36. }
  37.  
  38. sub arg_include_dirs {
  39.   my ($self, @dirs) = @_;
  40.  
  41.   # VMS can only have one include list, add the one from config.
  42.   if ($self->{config}{ccflags} =~ s{/inc[^=]+(?:=)+(?:\()?([^\/\)]*)} {}i) {
  43.     unshift @dirs, $1;
  44.   }
  45.   return unless @dirs;
  46.  
  47.   return ('/include=(' . join(',', @dirs) . ')');
  48. }
  49.  
  50. sub _do_link {
  51.   my ($self, $type, %args) = @_;
  52.   
  53.   my $objects = delete $args{objects};
  54.   $objects = [$objects] unless ref $objects;
  55.   
  56.   if ($args{lddl}) {
  57.  
  58.     # prelink will call Mksymlists, which creates the extension-specific
  59.     # linker options file and populates it with the boot symbol.
  60.  
  61.     my @temp_files = $self->prelink(%args, dl_name => $args{module_name});
  62.  
  63.     # We now add the rest of what we need to the linker options file.  We
  64.     # should replicate the functionality of C<ExtUtils::MM_VMS::dlsyms>,
  65.     # but there is as yet no infrastructure for handling object libraries,
  66.     # so for now we depend on object files being listed individually on the 
  67.     # command line, which should work for simple cases.  We do bring in our
  68.     # own version of C<ExtUtils::Liblist::Kid::ext> so that any additional
  69.     # libraries (including PERLSHR) can be added to the options file.
  70.  
  71.     my @optlibs = $self->_liblist_ext( $args{'libs'} );
  72.  
  73.     my $optfile = 'sys$disk:[]' . $temp_files[0];
  74.     open my $opt_fh, '>>', $optfile 
  75.         or die "_do_link: Unable to open $optfile: $!";
  76.     for my $lib (@optlibs) {print $opt_fh "$lib\n" if length $lib }
  77.     close $opt_fh;
  78.  
  79.     $objects->[-1] .= ',';
  80.     push @$objects, $optfile . '/OPTIONS,';
  81.  
  82.     # This one not needed for DEC C, but leave for completeness.
  83.     push @$objects, $self->perl_inc() . 'perlshr_attr.opt/OPTIONS';
  84.   }
  85.  
  86.   return $self->SUPER::_do_link($type, %args, objects => $objects);
  87. }
  88.  
  89. sub arg_nolink { return; }
  90.  
  91. sub arg_object_file {
  92.   my ($self, $file) = @_;
  93.   return "/obj=$file";
  94. }
  95.  
  96. sub arg_exec_file {
  97.   my ($self, $file) = @_;
  98.   return ("/exe=$file");
  99. }
  100.  
  101. sub arg_share_object_file {
  102.   my ($self, $file) = @_;
  103.   return ("$self->{config}{lddlflags}=$file");
  104. }
  105.  
  106.  
  107. sub lib_file {
  108.   my ($self, $dl_file) = @_;
  109.   $dl_file =~ s/\.[^.]+$//;
  110.   $dl_file =~ tr/"//d;
  111.   $dl_file = $dl_file .= '.' . $self->{config}{dlext};
  112.  
  113.   # Need to create with the same name as DynaLoader will load with.
  114.   if (defined &DynaLoader::mod2fname) {
  115.     my ($dev,$dir,$file) = File::Spec->splitpath($dl_file);
  116.     $file = DynaLoader::mod2fname([$file]);
  117.     $dl_file = File::Spec->catpath($dev,$dir,$file);
  118.   }
  119.   return $dl_file;
  120. }
  121.  
  122. # The following is reproduced almost verbatim from ExtUtils::Liblist::Kid::_vms_ext.
  123. # We can't just call that because it's tied up with the MakeMaker object hierarchy.
  124.  
  125. sub _liblist_ext {
  126.   my($self, $potential_libs,$verbose,$give_libs) = @_;
  127.   $verbose ||= 0;
  128.  
  129.   my(@crtls,$crtlstr);
  130.   @crtls = ( ($self->{'config'}{'ldflags'} =~ m-/Debug-i ? $self->{'config'}{'dbgprefix'} : '')
  131.               . 'PerlShr/Share' );
  132.   push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'perllibs'});
  133.   push(@crtls, grep { not /\(/ } split /\s+/, $self->{'config'}{'libc'});
  134.   # In general, we pass through the basic libraries from %Config unchanged.
  135.   # The one exception is that if we're building in the Perl source tree, and
  136.   # a library spec could be resolved via a logical name, we go to some trouble
  137.   # to insure that the copy in the local tree is used, rather than one to
  138.   # which a system-wide logical may point.
  139.   if ($self->perl_src) {
  140.     my($lib,$locspec,$type);
  141.     foreach $lib (@crtls) { 
  142.       if (($locspec,$type) = $lib =~ m{^([\w\$-]+)(/\w+)?} and $locspec =~ /perl/i) {
  143.         if    (lc $type eq '/share')   { $locspec .= $self->{'config'}{'exe_ext'}; }
  144.         elsif (lc $type eq '/library') { $locspec .= $self->{'config'}{'lib_ext'}; }
  145.         else                           { $locspec .= $self->{'config'}{'obj_ext'}; }
  146.         $locspec = catfile($self->perl_src, $locspec);
  147.         $lib = "$locspec$type" if -e $locspec;
  148.       }
  149.     }
  150.   }
  151.   $crtlstr = @crtls ? join(' ',@crtls) : '';
  152.  
  153.   unless ($potential_libs) {
  154.     warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
  155.     return ('', '', $crtlstr, '', ($give_libs ? [] : ()));
  156.   }
  157.  
  158.   my(@dirs,@libs,$dir,$lib,%found,@fndlibs,$ldlib);
  159.   my $cwd = cwd();
  160.   my($so,$lib_ext,$obj_ext) = @{$self->{'config'}}{'so','lib_ext','obj_ext'};
  161.   # List of common Unix library names and their VMS equivalents
  162.   # (VMS equivalent of '' indicates that the library is automatically
  163.   # searched by the linker, and should be skipped here.)
  164.   my(@flibs, %libs_seen);
  165.   my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
  166.                  'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
  167.                  'socket' => '', 'X11' => 'DECW$XLIBSHR',
  168.                  'Xt' => 'DECW$XTSHR', 'Xm' => 'DECW$XMLIBSHR',
  169.                  'Xmu' => 'DECW$XMULIBSHR');
  170.   if ($self->{'config'}{'vms_cc_type'} ne 'decc') { $libmap{'curses'} = 'VAXCCURSE'; }
  171.  
  172.   warn "Potential libraries are '$potential_libs'\n" if $verbose;
  173.  
  174.   # First, sort out directories and library names in the input
  175.   foreach $lib (split ' ',$potential_libs) {
  176.     push(@dirs,$1),   next if $lib =~ /^-L(.*)/;
  177.     push(@dirs,$lib), next if $lib =~ /[:>\]]$/;
  178.     push(@dirs,$lib), next if -d $lib;
  179.     push(@libs,$1),   next if $lib =~ /^-l(.*)/;
  180.     push(@libs,$lib);
  181.   }
  182.   push(@dirs,split(' ',$self->{'config'}{'libpth'}));
  183.  
  184.   # Now make sure we've got VMS-syntax absolute directory specs
  185.   # (We don't, however, check whether someone's hidden a relative
  186.   # path in a logical name.)
  187.   foreach $dir (@dirs) {
  188.     unless (-d $dir) {
  189.       warn "Skipping nonexistent Directory $dir\n" if $verbose > 1;
  190.       $dir = '';
  191.       next;
  192.     }
  193.     warn "Resolving directory $dir\n" if $verbose;
  194.     if (!File::Spec->file_name_is_absolute($dir)) { 
  195.         $dir = catdir($cwd,$dir); 
  196.     }
  197.   }
  198.   @dirs = grep { length($_) } @dirs;
  199.   unshift(@dirs,''); # Check each $lib without additions first
  200.  
  201.   LIB: foreach $lib (@libs) {
  202.     if (exists $libmap{$lib}) {
  203.       next unless length $libmap{$lib};
  204.       $lib = $libmap{$lib};
  205.     }
  206.  
  207.     my(@variants,$variant,$cand);
  208.     my($ctype) = '';
  209.  
  210.     # If we don't have a file type, consider it a possibly abbreviated name and
  211.     # check for common variants.  We try these first to grab libraries before
  212.     # a like-named executable image (e.g. -lperl resolves to perlshr.exe
  213.     # before perl.exe).
  214.     if ($lib !~ /\.[^:>\]]*$/) {
  215.       push(@variants,"${lib}shr","${lib}rtl","${lib}lib");
  216.       push(@variants,"lib$lib") if $lib !~ /[:>\]]/;
  217.     }
  218.     push(@variants,$lib);
  219.     warn "Looking for $lib\n" if $verbose;
  220.     foreach $variant (@variants) {
  221.       my($fullname, $name);
  222.  
  223.       foreach $dir (@dirs) {
  224.         my($type);
  225.  
  226.         $name = "$dir$variant";
  227.         warn "\tChecking $name\n" if $verbose > 2;
  228.         $fullname = VMS::Filespec::rmsexpand($name);
  229.         if (defined $fullname and -f $fullname) {
  230.           # It's got its own suffix, so we'll have to figure out the type
  231.           if    ($fullname =~ /(?:$so|exe)$/i)      { $type = 'SHR'; }
  232.           elsif ($fullname =~ /(?:$lib_ext|olb)$/i) { $type = 'OLB'; }
  233.           elsif ($fullname =~ /(?:$obj_ext|obj)$/i) {
  234.             warn "Note (probably harmless): "
  235.                 ."Plain object file $fullname found in library list\n";
  236.             $type = 'OBJ';
  237.           }
  238.           else {
  239.             warn "Note (probably harmless): "
  240.                 ."Unknown library type for $fullname; assuming shared\n";
  241.             $type = 'SHR';
  242.           }
  243.         }
  244.         elsif (-f ($fullname = VMS::Filespec::rmsexpand($name,$so))      or
  245.                -f ($fullname = VMS::Filespec::rmsexpand($name,'.exe')))     {
  246.           $type = 'SHR';
  247.           $name = $fullname unless $fullname =~ /exe;?\d*$/i;
  248.         }
  249.         elsif (not length($ctype) and  # If we've got a lib already, 
  250.                                        # don't bother
  251.                ( -f ($fullname = VMS::Filespec::rmsexpand($name,$lib_ext)) or
  252.                  -f ($fullname = VMS::Filespec::rmsexpand($name,'.olb'))))  {
  253.           $type = 'OLB';
  254.           $name = $fullname unless $fullname =~ /olb;?\d*$/i;
  255.         }
  256.         elsif (not length($ctype) and  # If we've got a lib already, 
  257.                                        # don't bother
  258.                ( -f ($fullname = VMS::Filespec::rmsexpand($name,$obj_ext)) or
  259.                  -f ($fullname = VMS::Filespec::rmsexpand($name,'.obj'))))  {
  260.           warn "Note (probably harmless): "
  261.                ."Plain object file $fullname found in library list\n";
  262.           $type = 'OBJ';
  263.           $name = $fullname unless $fullname =~ /obj;?\d*$/i;
  264.         }
  265.         if (defined $type) {
  266.           $ctype = $type; $cand = $name;
  267.           last if $ctype eq 'SHR';
  268.         }
  269.       }
  270.       if ($ctype) { 
  271.         # This has to precede any other CRTLs, so just make it first
  272.         if ($cand eq 'VAXCCURSE') { unshift @{$found{$ctype}}, $cand; }  
  273.         else                      { push    @{$found{$ctype}}, $cand; }
  274.         warn "\tFound as $cand (really $fullname), type $ctype\n" 
  275.           if $verbose > 1;
  276.     push @flibs, $name unless $libs_seen{$fullname}++;
  277.         next LIB;
  278.       }
  279.     }
  280.     warn "Note (probably harmless): "
  281.          ."No library found for $lib\n";
  282.   }
  283.  
  284.   push @fndlibs, @{$found{OBJ}}                      if exists $found{OBJ};
  285.   push @fndlibs, map { "$_/Library" } @{$found{OLB}} if exists $found{OLB};
  286.   push @fndlibs, map { "$_/Share"   } @{$found{SHR}} if exists $found{SHR};
  287.   $lib = join(' ',@fndlibs);
  288.  
  289.   $ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
  290.   warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
  291.   wantarray ? ($lib, '', $ldlib, '', ($give_libs ? \@flibs : ())) : $lib;
  292. }
  293.  
  294. 1;
  295.